home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / os2 / kzr0597.zip / COS.CMD < prev    next >
OS/2 REXX Batch file  |  1997-03-09  |  4KB  |  117 lines
  1. /* REXX-Programm cos.cmd */
  2.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  3.    Call SysLoadFuncs
  4. /*   Signal on syntax name cosMsg */
  5.  
  6. /* Diese Variablen müssen für jede Prozedur definiert werden, damit die  */
  7. /* Prozedur die Variable bufND kennt und die Variable ND übernehmen kann.*/
  8.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  9.    lp=LastPos("\", Pfd)
  10.    Pfd=DelStr(Pfd, 1+lp)
  11.    NDAcos=Pfd||"NDAcos.DAT"
  12.    bufND =Pfd||"NDZahl.DAT"
  13.    bufMsg=Pfd||"Meldung.DAT"
  14.    ND = LineIn(bufND, 1)
  15.    Numeric Digits ND+10
  16.  
  17.    arg xx,y
  18.    p0p=xx*xx /* Diese Anweisung prvoziert eine Syntax-Fehlermeldung */
  19.  
  20.    if length(y) > 0 then
  21.    do
  22.      call charout(NDAcos); Call SysFileDelete NDAcos
  23.      ret=LineOut(bufMsg, "Im Argument von  cos(...)  ist mindestens  1  nicht zulässiges Komma !")
  24.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  25.   /*  damit in den diesbezüglichen temporären Dateien                      */
  26.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  27.      EXIT
  28.    end
  29.  
  30.    if ND > 450 then
  31.    do
  32.      ND=450
  33.      call charout(NDAcos) ; Call SysFileDelete NDAcos
  34.      ret=LineOut(NDAcos, 450)
  35.      Call Charout,"   Achtung, nur 450 Dezimalstellen bei der Berechnung von   cos(...)"
  36.      say
  37.      Beep(444, 200); Beep(628,300)  /* Hier kein EXIT ! */
  38.    end
  39.  
  40.    /* Wenn ND <= 450 ist, wird ND = ND  weitergegeben */
  41.    call charout(NDAcos) ; Call SysFileDelete NDAcos
  42.    ret=LineOut(NDAcos, ND)
  43.  
  44.    if xx = 0 then do; y=1; Signal W; end
  45.  
  46.    pi=3.||,
  47.    1415926535897932384626433832795028841971693993751058209749445923078||,
  48.    164062862089986280348253421170679821480865132823066470938446095505822317||,
  49.    253594081284811174502841027019385211055596446229489549303819644288109756||,
  50.    659334461284756482337867831652712019091456485669234603486104543266482133||,
  51.    936072602491412737245870066063155881748815209209628292540917153643678925||,
  52.    903600113305305488204665213841469519415116094330572703657595919530921861||,
  53.    173819326117931051185480744623799627495673518857527248912279381830119491||,
  54.    298336733624406566430860213949463952247371907021798609437027705392171762||,
  55.    93176752384674818467669405132
  56.  
  57.    pi14=pi/4;
  58.  
  59.    x=abs(xx)//(2*pi)
  60.    /* x bleibt im Intervall  0 < x < 2*pi  */
  61.  
  62.    vz=1
  63.    /* Das Intervall  0 < x < 2*pi  wird so zerlegt, daß die Reihen für     */
  64.    /* sin(x)  und  cos(x)  immer nur für Werte  x < π/4  verwendet werden. */
  65.    select
  66.      when x > 7*pi14 then do; x = 2*pi-x;   vz=+1; Signal Cos; end
  67.      when x > 6*pi14 then do; x = x-3*pi/2; vz=+1; Signal Sin; end
  68.      when x > 5*pi14 then do; x = 3*pi/2-x; vz=-1; Signal Sin; end
  69.      when x > 4*pi14 then do; x = x-pi;     vz=-1; Signal Cos; end
  70.      when x > 3*pi14 then do; x = pi-x;     vz=-1; Signal Cos; end
  71.      when x > 2*pi14 then do; x = x-pi/2;   vz=-1; Signal Sin; end
  72.      when x >   pi14 then do; x = pi/2-x;   vz=+1; Signal Sin; end
  73.      when x >   0    then do; x = x;        vz=+1; Signal Cos; end
  74.      otherwise NOP
  75.    end
  76.  
  77. Sin:
  78.    /* Reihe sin(x) */
  79.    g=1; z=x**2 ; m=2; v=1
  80.    do forever
  81.      g=-g*z/(m*(m+1))
  82.      if abs(g/v) < 10**(-ND-7) then leave
  83.      v=v+g
  84.      m=m+2
  85.    end
  86.    y=v*x*vz
  87.    Signal W
  88.  
  89. Cos:
  90.    /* Reihe cos(x) */
  91.    g=1; z=x**2; m=2; v=1
  92.    do forever
  93.      g=-g*z/(m*(m-1))
  94.      if (abs(g/v) < 10**(-ND-7)) then leave
  95.      v=v+g
  96.      m=m+2
  97.    end
  98.    y=v*vz
  99.  
  100. W: numeric digits ND
  101.    return(Format(y))
  102.  
  103. EXIT
  104.  
  105. cosMsg:
  106.    sf=ErrorText(RC)
  107.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  108.    do
  109.      call charout(NDAcos); Call SysFileDelete NDAcos
  110.      ret=LineOut(bufMsg, "Sie haben in  cos(...)  kein gültiges Argument eingegeben !")
  111.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  112.   /*  damit in den diesbezüglichen temporären Dateien                      */
  113.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  114.      EXIT
  115.    end
  116.  
  117.